home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / ChipCD_1.03.iso / zkuste / delphi / kolekce / d3456 / GmPrintSuite_2_61_Lite.exe / {app} / GmCanvas.pas next >
Encoding:
Pascal/Delphi Source File  |  2002-10-05  |  31.1 KB  |  880 lines
  1. {******************************************************************************}
  2. {                                                                              }
  3. {                           GmCanvas.pas v2.61 Lite                            }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.co.uk               }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.co.uk                              }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmCanvas;
  14.  
  15. interface
  16.  
  17. uses Windows, Graphics, Forms, Classes, GmPrinter, GmTypes, GmObjects;
  18.  
  19. type
  20.   // Conditional define which gives information on the compiler version...
  21.  
  22.   {$I GMPS.INC}
  23.  
  24.   TGmCustomLabelPrinter = class(TGmComponent);
  25.   TGmCustomGridPrint    = class(TGmComponent);
  26.  
  27.   TGmCanvas = class
  28.   private
  29.     FFont: TFont;
  30.     FBrush: TBrush;
  31.     FPen: TPen;
  32.     FClipObjects: Boolean;
  33.     FClipRect: TRect;
  34.     FCopyMode: TCopyMode;
  35.     FDefaultMeasurement: TGmMeasurement;
  36.     FDrawOffset: TGmPoint;
  37.     FLastObject: TGmBaseObject;
  38.     FMetafile: TMetafile;
  39.     FMetafileCanvas: TMetafileCanvas;
  40.     FPage: TGmPage;
  41.     FPenPos: TPoint;
  42.     FPreview: TGmCustomPreview;
  43.     FTempValueSize: TGmValueSize;
  44.     // events...
  45.     FOnChange: TNotifyEvent;
  46.     function CalcTextBoxHeight(x, y, x2: integer; AText: string): integer;
  47.     function GetBrush: TBrush;
  48.     function GetFont: TFont;
  49.     function GetGmValueSize: TGmValueSize;
  50.     function GetOffsetAsUnits: TPoint;
  51.     function GetPen: TPen;
  52.     function GetPenPos: TPoint;
  53.     {$IFDEF D4+}
  54.     procedure DrawPolyShape(FPolyID: integer; Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  55.     {$ENDIF}
  56.     procedure SetBrush(ABrush: TBrush);
  57.     procedure SetFont(AFont: TFont);
  58.     procedure SetPen(APen: TPen);
  59.   protected
  60.     procedure AddObjectToPage(AObject: TGmBaseObject);
  61.     procedure TextOutExt(x, y, Angle: Extended; AText: string; GmMeasurement: TGmMeasurement);
  62.   public
  63.     constructor Create(APreview: TGmCustomPreview);
  64.     destructor Destroy; override;
  65.     function GraphicExtent(AGraphic: TGraphic; GmMeasurement: TGmMeasurement): TGmSize;
  66.     function GraphicHeight(AGraphic: TGraphic): TGmValue;
  67.     function GraphicWidth(AGraphic: TGraphic): TGmValue;
  68.     function TextExtent(AText: string): TGmValueSize;
  69.     function TextHeight(AText: string): TGmValue;
  70.     function TextWidth(AText: string): TGmValue;
  71.     // drawing functions...
  72.     function TextBox(x, y, x2, y2: Extended; AText: string; Alignment: TAlignment;
  73.       Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;
  74.     function TextBoxExt(x, y, x2, y2: Extended; AText: string;
  75.       Alignment: TAlignment; VertAlignment: TGmVertAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;
  76.  
  77.     procedure Arc(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);               {$IFDEF D4+} overload; {$ENDIF}
  78.     procedure Chord(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);             {$IFDEF D4+} overload; {$ENDIF}
  79.     procedure Draw(x, y: Extended; AGraphic: TGraphic; Scale: Extended; GmMeasurement: TGmMeasurement); {$IFDEF D4+} overload; {$ENDIF}
  80.     procedure DrawTrans(x, y: Extended; AGraphic: TGraphic; Scale: Extended; GmMeasurement: TGmMeasurement;
  81.       TransparentColor: TColor);                                                                        {$IFDEF D4+} overload; {$ENDIF}
  82.     procedure Ellipse(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);                           {$IFDEF D4+} overload; {$ENDIF}
  83.     procedure FillRect(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);                          {$IFDEF D4+} overload; {$ENDIF}
  84.     procedure FloatOut(x, y, AValue: Extended; Format: string; GmMeasurement: TGmMeasurement);          {$IFDEF D4+} overload; {$ENDIF}
  85.     procedure Line(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);                              {$IFDEF D4+} overload; {$ENDIF}
  86.     procedure MoveTo(x, y: Extended; GmMeasurement: TGmMeasurement);                                    {$IFDEF D4+} overload; {$ENDIF}
  87.     procedure LineTo(x, y: Extended; GmMeasurement: TGmMeasurement);                                    {$IFDEF D4+} overload; {$ENDIF}
  88.     procedure Pie(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);               {$IFDEF D4+} overload; {$ENDIF}
  89.     {$IFDEF D4+}
  90.     procedure Polygon(Points: array of TGmPoint; GmMeasurement: TGmMeasurement); overload;
  91.     procedure PolyLine(Points: array of TGmPoint; GmMeasurement: TGmMeasurement); overload;
  92.     procedure PolyLineTo(Points: array of TGmPoint; GmMeasurement: TGmMeasurement); overload;
  93.     procedure PolyBezier(Points: array of TGmPoint; GmMeasurement: TGmMeasurement); overload;
  94.     procedure PolyBezierTo(Points: array of TGmPoint; GmMeasurement: TGmMeasurement); overload;
  95.     {$ENDIF}
  96.     procedure Rectangle(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);                      {$IFDEF D4+} overload; {$ENDIF}
  97.     procedure RotateOut(x, y, Angle: Extended; AText: string; GmMeasurement: TGmMeasurement);        {$IFDEF D4+} overload; {$ENDIF}
  98.     procedure RoundRect(x, y, x2, y2, x3, y3: Extended; GmMeasurement: TGmMeasurement);              {$IFDEF D4+} overload; {$ENDIF}
  99.     procedure SetDrawingOffset(inchX, inchY: Extended);
  100.     procedure StretchDraw(x,y, x2, y2: Extended; AGraphic: TGraphic; GmMeasurement: TGmMeasurement); {$IFDEF D4+} overload; {$ENDIF}
  101.     procedure StretchDrawTrans(x,y, x2, y2: Extended; AGraphic: TGraphic;
  102.       GmMeasurement: TGmMeasurement; TransparentColor: TColor);                                      {$IFDEF D4+} overload; {$ENDIF}
  103.     procedure TextOut(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);                 {$IFDEF D4+} overload; {$ENDIF}
  104.     procedure TextOutCenter(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);           {$IFDEF D4+} overload; {$ENDIF}
  105.     procedure TextOutLeft(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);             {$IFDEF D4+} overload; {$ENDIF}
  106.     procedure TextOutRight(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);            {$IFDEF D4+} overload; {$ENDIF}
  107.  
  108.     {$IFDEF D4+}
  109.  
  110.     // *** overloaded canvas functions which use the DefaultMeasurement property ***
  111.  
  112.     procedure Arc(x, y, x2, y2, x3, y3, x4, y4: Extended); overload;
  113.     procedure Chord(x, y, x2, y2, x3, y3, x4, y4: Extended); overload;
  114.     procedure Draw(x, y: Extended; AGraphic: TGraphic; Scale: Extended); overload;
  115.     procedure DrawTrans(x, y: Extended; AGraphic: TGraphic; Scale: Extended; TransparentColor: TColor); overload;
  116.     procedure Ellipse(x, y, x2, y2: Extended); overload;
  117.     procedure FillRect(x, y, x2, y2: Extended); overload;
  118.     procedure FloatOut(x, y, AValue: Extended; Format: string);  overload;
  119.     procedure Line(x, y, x2, y2: Extended); overload;
  120.     procedure LineTo(x, y: Extended); overload;
  121.     procedure MoveTo(x, y: Extended); overload;
  122.     procedure Pie(x, y, x2, y2, x3, y3, x4, y4: Extended); overload;
  123.     procedure Polygon(Points: array of TGmPoint); overload;
  124.     procedure PolyLine(Points: array of TGmPoint); overload;
  125.     procedure PolyLineTo(Points: array of TGmPoint); overload;
  126.     procedure PolyBezier(Points: array of TGmPoint); overload;
  127.     procedure PolyBezierTo(Points: array of TGmPoint); overload;
  128.     procedure Rectangle(x, y, x2, y2: Extended); overload;
  129.     procedure RotateOut(x, y, Angle: Extended; AText: string); overload;
  130.     procedure RoundRect(x, y, x2, y2, x3, y3: Extended); overload;
  131.     procedure StretchDraw(x,y, x2, y2: Extended; AGraphic: TGraphic); overload;
  132.     procedure TextOut(x, y: Extended; AText: string); overload;
  133.     procedure TextOutCenter(x, y: Extended; AText: string); overload;
  134.     procedure TextOutLeft(x, y: Extended; AText: string); overload;
  135.     procedure TextOutRight(x, y: Extended; AText: string); overload;
  136.  
  137.     {$ENDIF}
  138.  
  139.     // path functions...
  140.     procedure BeginPath;
  141.     procedure EndPath;
  142.     procedure FillPath;
  143.     procedure StrokePath;
  144.     procedure StrokeAndFillPath;
  145.     procedure CloseFigure;
  146.  
  147.     procedure SetBrushValues(AColor: TColor; AStyle: TBrushStyle);
  148.     procedure SetFontValues(AName: string; ASize: integer; AColor: TColor; AStyle: TFontStyles);
  149.     procedure SetPenValues(AWidth: integer; AColor: TColor; AStyle: TPenStyle);
  150.  
  151.     property Brush: TBrush read GetBrush write SetBrush;
  152.     property ClipObjects: Boolean read FClipObjects write FClipObjects default False;
  153.     property ClipRect: TRect read FClipRect write FClipRect;
  154.     property CopyMode: TCopyMode read FCopyMode write FCopyMode default cmSrcCopy;
  155.     property DefaultMeasurement: TGmMeasurement read FDefaultMeasurement write FDefaultMeasurement default GmMillimeters;
  156.     property Font: TFont read GetFont write SetFont;
  157.     property LastObject: TGmBaseObject read FLastObject;
  158.     property Page: TGmPage read FPage write FPage;
  159.     property Pen: TPen read GetPen write SetPen;
  160.     property PenPos: TPoint read GetPenPos;
  161.     // events...
  162.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  163.   end;
  164.  
  165. implementation
  166.  
  167. uses Sysutils, GmPreview, GmConst, JPeg, GmErrors;
  168.  
  169. //------------------------------------------------------------------------------
  170.  
  171. // *** Global functions ***
  172.  
  173. function IconToBitmap(AIcon: TIcon): TBitmap;
  174. begin
  175.   Result := TBitmap.Create;
  176.   Result.Width := AIcon.Width;
  177.   Result.Height := AIcon.Height;
  178.   Result.PixelFormat := pf24Bit;
  179.   Result.Canvas.Draw(0,0,AIcon);
  180. end;
  181.  
  182. //------------------------------------------------------------------------------
  183.  
  184. // TGmCanvas Constructor/Destructor...
  185.  
  186. constructor TGmCanvas.Create(APreview: TGmCustomPreview);
  187. begin
  188.   inherited Create;
  189.   FBrush := TBrush.Create;
  190.   FFont := TFont.Create;
  191.   FPen := TPen.Create;
  192.   FPreview := APreview;
  193.   FMetafile := TMetafile.Create;
  194.   FMetafileCanvas := TMetafileCanvas.Create(FMetafile, 0);
  195.   FFont.PixelsPerInch := DRAWING_DPI;
  196.   FMetafileCanvas.Font.PixelsPerInch := DRAWING_DPI;
  197.   FFont.Name := DEFAULT_FONT;
  198.   FFont.Color := clBlack;
  199.   FFont.Size := DEFAULT_FONT_SIZE;
  200.   FMetafileCanvas.Font.Assign(FFont);
  201.   Brush.Style := bsClear;
  202.   FDrawOffset := GmPoint(0,0);
  203.   FPenPos := Point(0,0);
  204.   FCopyMode := cmSrcCopy;
  205.   FClipObjects := False;
  206.   FDefaultMeasurement := GmMillimeters;
  207. end;
  208.  
  209. destructor TGmCanvas.Destroy;
  210. begin
  211.   FBrush.Free;
  212.   FFont.Free;
  213.   FPen.Free;
  214.   FMetafileCanvas.Free;
  215.   FMetafile.Free;
  216.   if FTempValueSize <> nil then FTempValueSize.Free;
  217.   inherited Destroy;
  218. end;
  219.  
  220. //------------------------------------------------------------------------------
  221.  
  222. // *** Private functions ***
  223.  
  224. function TGmCanvas.CalcTextBoxHeight(x, y, x2: Integer; AText: string): integer;
  225. var
  226.   CalcRect: TRect;
  227.   AsPixels: integer;
  228. begin
  229.   CalcRect.Left   := Round(ConvertValue(x, GmUnits, GmInches) * DRAWING_DPI);
  230.   CalcRect.Top    := Round(ConvertValue(y, GmUnits, GmInches) * DRAWING_DPI);
  231.   CalcRect.Right  := Round(ConvertValue(x2, GmUnits, GmInches) * DRAWING_DPI);
  232.   FMetafileCanvas.Font.PixelsPerInch := DRAWING_DPI;
  233.   FMetafileCanvas.Font.Assign(Font);
  234.   AsPixels := Windows.DrawText(FMetafileCanvas.Handle,
  235.               PChar(AText),
  236.               Length(AText),
  237.               CalcRect,
  238.               DT_NOPREFIX+
  239.               DT_WORDBREAK+
  240.               DT_EXPANDTABS+
  241.               DT_CALCRECT);
  242.   Result := Round(((AsPixels / DRAWING_DPI) * MM_PER_INCH) * 100);
  243. end;
  244.  
  245. function TGmCanvas.GetBrush: TBrush;
  246. begin
  247.   Result := FBrush;
  248. end;
  249.  
  250. function TGmCanvas.GetFont: TFont;
  251. begin
  252.   Result := FFont;
  253. end;
  254.  
  255. function TGmCanvas.GetGmValueSize: TGmValueSize;
  256. begin
  257.   if not Assigned(FTempValueSize) then FTempValueSize := TGmValueSize.Create;
  258.   Result := FTempValueSize;
  259. end;
  260.  
  261. function TGmCanvas.GetOffsetAsUnits: TPoint;
  262. begin
  263.   Result.x := Round(ConvertValue(FDrawOffset.x, GmInches, GmUnits));
  264.   Result.y := Round(ConvertValue(FDrawOffset.y, GmInches, GmUnits));
  265. end;
  266.  
  267. function TGmCanvas.GetPen: TPen;
  268. begin
  269.   Result := FPen;
  270. end;
  271.  
  272. function TGmCanvas.GetPenPos: TPoint;
  273. var
  274.   AOffset: TPoint;
  275. begin
  276.   AOffset := GetOffsetAsUnits;
  277.   Result.x := FPenPos.x - AOffset.x;
  278.   Result.y := FPenPos.y - AOffset.y;
  279. end;
  280.  
  281. {$IFDEF D4+}
  282.  
  283. procedure TGmCanvas.DrawPolyShape(FPolyID: integer; Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  284. var
  285.   APolyObject: TGmPolyBaseObject;
  286.   ICount: integer;
  287. begin
  288.   // create a new polygon object and set its values...
  289.   case FPolyID of
  290.     GM_POLYGON_ID     : APolyObject := TGmPolygonObject.Create;
  291.     GM_POLYLINE_ID    : APolyObject := TGmPolyLineObject.Create;
  292.     GM_POLYBEZIER_ID  : APolyObject := TGmPolyBezierObject.Create;
  293.     GM_POLYLINETO_ID  : APolyObject := TGmPolyLineToObject.Create;
  294.     GM_POLYBEZIERTO_ID: APolyObject := TGmPolyBezierToObject.Create;
  295.   else
  296.     Exit;
  297.   end;
  298.   if not Assigned(APolyObject) then Exit;
  299.   SetLength(APolyObject.Points, High(Points)+1);
  300.   for ICount := 0 to High(Points) do
  301.   begin
  302.     APolyObject.Points[ICount].x := Round(ConvertValue(Points[ICount].x, GmMeasurement, GmUnits));
  303.     APolyObject.Points[ICount].y := Round(ConvertValue(Points[ICount].y, GmMeasurement, GmUnits));
  304.   end;
  305.   APolyObject.Brush  := BrushToGmBrush(Brush);
  306.   APolyObject.Pen    := PenToGmPen(Pen);
  307.   AddObjectToPage(APolyObject);
  308. end;
  309.  
  310. {$ENDIF}
  311.  
  312. procedure TGmCanvas.SetBrush(ABrush: TBrush);
  313. begin
  314.   FBrush.Assign(ABrush);
  315. end;
  316.  
  317. procedure TGmCanvas.SetFont(AFont: TFont);
  318. begin
  319.   FFont.Assign(AFont);
  320. end;
  321.  
  322. procedure TGmCanvas.SetPen(APen: TPen);
  323. begin
  324.   FPen.Assign(APen);
  325. end;
  326.  
  327. //------------------------------------------------------------------------------
  328.  
  329. // *** Protected functions ***
  330.  
  331. procedure TGmCanvas.AddObjectToPage(AObject: TGmBaseObject);
  332. begin
  333.   // add the TGmBaseObject to the list of objects for the current page...
  334.   AObject.OffsetObject(FDrawOffset.x, FDrawOffset.y);
  335.   AObject.Page := TGmPreview(FPreview).CurrentPage;
  336.   AObject.ClipObject := FClipObjects;
  337.   AObject.ClipRect := FClipRect;
  338.   Page.AddObject(AObject);
  339.   FLastObject := AObject;
  340.   if Assigned(FOnChange) then FOnChange(Self);
  341. end;
  342.  
  343. procedure TGmCanvas.TextOutExt(x, y, Angle: Extended; AText: string; GmMeasurement: TGmMeasurement);
  344. var
  345.   ATextObject: TGmTextObject;
  346. begin
  347.   // Create a text object and add it to the page objects list...
  348.   ATextObject := TGmTextObject.Create;
  349.   ATextObject.Preview := FPreview;
  350.   ATextObject.Font  := FontToGmFont(Font);
  351.   ATextObject.Page := Page.PageNum;
  352.   ATextObject.SetTextAngle(Angle);
  353.   ATextObject.Brush := BrushToGmBrush(Brush);
  354.   ATextObject.X := Round(ConvertValue(x, GmMeasurement, GmUnits));
  355.   ATextObject.Y := Round(ConvertValue(y, GmMeasurement, GmUnits));
  356.   ATextObject.Alignment := taLeftJustify;
  357.   ATextObject.Caption := AText;
  358.   AddObjectToPage(ATextObject);
  359.   FPenPos.y := ATextObject.y;
  360.   FPenPos.x := ATextObject.x + TextWidth(AText).AsUnits;
  361. end;
  362.  
  363. //------------------------------------------------------------------------------
  364.  
  365. // Public functions...
  366.  
  367. function TGmCanvas.GraphicExtent(AGraphic: TGraphic; GmMeasurement: TGmMeasurement): TGmSize;
  368. begin
  369.   Result.Height := GraphicHeight(AGraphic).AsGmValue[GmMeasurement];
  370.   Result.Width  := GraphicWidth(AGraphic).AsGmValue[GmMeasurement];
  371. end;
  372.  
  373. function TGmCanvas.GraphicHeight(AGraphic: TGraphic): TGmValue;
  374. begin
  375.   Result := GetGmValueSize.Height;
  376.   Result.AsPixels[SCREEN_PPI] := AGraphic.Height;
  377. end;
  378.  
  379. function TGmCanvas.GraphicWidth(AGraphic: TGraphic): TGmValue;
  380. begin
  381.   Result := GetGmValueSize.Width;
  382.   Result.AsPixels[SCREEN_PPI] := AGraphic.Width;
  383. end;
  384.  
  385. function TGmCanvas.TextExtent(AText: string): TGmValueSize;
  386. begin
  387.   Result := GetGmValueSize;
  388.   Result.Height.AsInches := TextHeight(AText).AsInches;
  389.   Result.Width.AsInches  := TextWidth(AText).AsInches;
  390. end;
  391.  
  392. function TGmCanvas.TextHeight(AText: string): TGmValue;
  393. begin
  394.   Result := GetGmValueSize.Height;
  395.   FMetafileCanvas.Font.PixelsPerInch := DRAWING_DPI;
  396.   FMetafileCanvas.Font.Assign(Font);
  397.   Result.AsInches := FMetafileCanvas.TextHeight(AText) / DRAWING_DPI;
  398. end;
  399.  
  400. function TGmCanvas.TextWidth(AText: string): TGmValue;
  401. begin
  402.   Result := GetGmValueSize.Width;
  403.   FMetafileCanvas.Font.PixelsPerInch := DRAWING_DPI;
  404.   FMetafileCanvas.Font.Assign(Font);
  405.   Result.AsInches := FMetafileCanvas.TextWidth(AText) / DRAWING_DPI;
  406. end;
  407.  
  408. //------------------------------------------------------------------------------
  409.  
  410. // *** Drawing functions ***
  411.  
  412. function TGmCanvas.TextBox(x, y, x2, y2: Extended; AText: string;
  413.   Alignment: TAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;
  414. begin
  415.   Result := TextBoxExt(x, y, x2, y2, AText, Alignment, gmTop, Draw, GmMeasurement);
  416. end;
  417.  
  418. function TGmCanvas.TextBoxExt(x, y, x2, y2: Extended; AText: string;
  419.   Alignment: TAlignment; VertAlignment: TGmVertAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;
  420. var
  421.   ATextBox: TGmTextBoxObject;
  422.   ARect: TRect;
  423. begin
  424.   // create a textbox object and set its values...
  425.   ARect.Left  := Round(ConvertValue(x,  GmMeasurement, GmUnits));
  426.   ARect.Top   := Round(ConvertValue(y,  GmMeasurement, GmUnits));
  427.   ARect.Right := Round(ConvertValue(x2, GmMeasurement, GmUnits));
  428.   if y2 <> 0 then
  429.     ARect.Bottom := Round(ConvertValue(y2, GmMeasurement, GmUnits))
  430.   else
  431.     ARect.Bottom := ARect.Top + CalcTextBoxHeight(ARect.Left, ARect.Top, ARect.Right, AText);
  432.   Result := ConvertValue(ARect.Bottom-ARect.Top, GmUnits, GmMeasurement);
  433.   if not Draw then Exit;
  434.   ATextBox := TGmTextBoxObject.Create;
  435.   ATextBox.CoordsAsRect := ARect;
  436.   ATextBox.Alignment := Alignment;
  437.   ATextBox.VertAlignment := VertAlignment;
  438.   ATextBox.Brush := BrushToGmBrush(Brush);
  439.   ATextBox.Font  := FontToGmFont(Font);
  440.   ATextBox.Pen   := PenToGmPen(Pen);
  441.   ATextBox.Caption := AText;
  442.   AddObjectToPage(ATextBox);
  443. end;
  444.  
  445. procedure TGmCanvas.Arc(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);
  446. begin
  447.   ShowGmMessage(nil, '"TGmPreview.Canvas.Arc"'+#13+#13+PRO_VERSION_ONLY);
  448. end;
  449.  
  450. procedure TGmCanvas.Chord(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);
  451. begin
  452.   ShowGmMessage(nil, '"TGmPreview.Canvas.Chord"'+#13+#13+PRO_VERSION_ONLY);
  453. end;
  454.  
  455. procedure TGmCanvas.Draw(x, y: Extended; AGraphic: TGraphic; Scale: Extended; GmMeasurement: TGmMeasurement);
  456. var
  457.   ARect: TGmRect;
  458.   GraphicSize: TGmSize;
  459. begin
  460.   // Create an Graphic object and add it to the page objects list...
  461.   GraphicSize := GraphicExtent(AGraphic, GmMeasurement);
  462.   ARect.Left    := x;
  463.   ARect.Top     := y;
  464.   ARect.Right   := x + (GraphicSize.Width * Scale);
  465.   ARect.Bottom  := y + (GraphicSize.Height * Scale);
  466.   StretchDraw(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, AGraphic, GmMeasurement);
  467. end;
  468.  
  469. procedure TGmCanvas.DrawTrans(x, y: Extended; AGraphic: TGraphic; Scale: Extended; GmMeasurement: TGmMeasurement;
  470.   TransparentColor: TColor);
  471. begin
  472.   Draw(x, y, AGraphic, Scale, GmMeasurement);
  473.   TGmGraphicObject(LastObject).TransparentColor := TransparentColor;
  474. end;
  475.  
  476. procedure TGmCanvas.Ellipse(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);
  477. var
  478.   AEllipseShape: TGmEllipseShape;
  479. begin
  480.   // Create a Line object and add it to the page objects list...
  481.   AEllipseShape := TGmEllipseShape.Create;
  482.   AEllipseShape.Pen   := PenToGmPen(Pen);
  483.   AEllipseShape.Brush := BrushToGmBrush(Brush);
  484.   AEllipseShape.X     := Round(ConvertValue(x, GmMeasurement, GmUnits));
  485.   AEllipseShape.Y     := Round(ConvertValue(y, GmMeasurement, GmUnits));
  486.   AEllipseShape.X2    := Round(ConvertValue(x2, GmMeasurement, GmUnits));
  487.   AEllipseShape.Y2    := Round(ConvertValue(y2, GmMeasurement, GmUnits));
  488.   AddObjectToPage(AEllipseShape);
  489. end;
  490.  
  491. procedure TGmCanvas.FillRect(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);
  492. begin
  493.   ShowGmMessage(nil, '"TGmPreview.Canvas.FillRect"'+#13+#13+PRO_VERSION_ONLY);
  494. end;
  495.  
  496. procedure TGmCanvas.FloatOut(x, y, AValue: Extended; Format: string; GmMeasurement: TGmMeasurement);
  497. var
  498.   AStrValue: string;
  499. begin
  500.   // draw a float value to the page with a specific format...
  501.   AStrValue := FormatFloat(Format, AValue);
  502.   TextOutRight(x, y, AStrValue, GmMeasurement);
  503. end;
  504.  
  505. procedure TGmCanvas.Line(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);
  506. var
  507.   ALineObject: TGmLineObject;
  508. begin
  509.   // Create a Line object and add it to the page objects list...
  510.   ALineObject := TGmLineObject.Create;
  511.   ALineObject.Pen := PenToGmPen(Pen);
  512.   ALineObject.X   := Round(ConvertValue(x, GmMeasurement, GmUnits));
  513.   ALineObject.Y   := Round(ConvertValue(y, GmMeasurement, GmUnits));
  514.   ALineObject.X2  := Round(ConvertValue(x2, GmMeasurement, GmUnits));
  515.   ALineObject.Y2  := Round(ConvertValue(y2, GmMeasurement, GmUnits));
  516.   AddObjectToPage(ALineObject);
  517. end;
  518.  
  519. procedure TGmCanvas.MoveTo(x, y: Extended; GmMeasurement: TGmMeasurement);
  520. begin
  521.   FPenPos.x := Round(ConvertValue(x, GmMeasurement, GmUnits));
  522.   FPenPos.y := Round(ConvertValue(y, GmMeasurement, GmUnits));
  523. end;
  524.  
  525. procedure TGmCanvas.Pie(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);
  526. begin
  527.   ShowGmMessage(nil, '"TGmPreview.Canvas.Pie"'+#13+#13+PRO_VERSION_ONLY);
  528. end;
  529.  
  530. procedure TGmCanvas.LineTo(x, y: Extended; GmMeasurement: TGmMeasurement);
  531. var
  532.   StartPos: TPoint;
  533. begin
  534.   StartPos := FPenPos;
  535.   MoveTo(x, y, GmMeasurement);
  536.   Line(StartPos.x,
  537.        StartPos.y,
  538.        FPenPos.x,
  539.        FPenPos.y,
  540.        GmUnits);
  541. end;
  542.  
  543. {$IFDEF D4+}
  544.  
  545. procedure TGmCanvas.Polygon(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  546. begin
  547.   DrawPolyShape(GM_POLYGON_ID, Points, GmMeasurement);
  548. end;
  549.  
  550. procedure TGmCanvas.PolyLine(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  551. begin
  552.   DrawPolyShape(GM_POLYLINE_ID, Points, GmMeasurement);
  553. end;
  554.  
  555. procedure TGmCanvas.PolyLineTo(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  556. begin
  557.   DrawPolyShape(GM_POLYLINETO_ID, Points, GmMeasurement);
  558. end;
  559.  
  560. procedure TGmCanvas.PolyBezier(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  561. begin
  562.   DrawPolyShape(GM_POLYBEZIER_ID, Points, GmMeasurement);
  563. end;
  564.  
  565. procedure TGmCanvas.PolyBezierTo(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  566. begin
  567.   DrawPolyShape(GM_POLYBEZIERTO_ID, Points, GmMeasurement);
  568. end;
  569.  
  570. {$ENDIF} 
  571.  
  572. procedure TGmCanvas.Rectangle(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);
  573. var
  574.   ARectangleShape: TGmRectangleShape;
  575. begin
  576.   // Create a Rectangle object and add it to the page objects list...
  577.   ARectangleShape := TGmRectangleShape.Create;
  578.   ARectangleShape.Pen   := PenToGmPen(Pen);
  579.   ARectangleShape.Brush := BrushToGmBrush(Brush);
  580.   ARectangleShape.X     := Round(ConvertValue(x, GmMeasurement, GmUnits));
  581.   ARectangleShape.Y     := Round(ConvertValue(y, GmMeasurement, GmUnits));
  582.   ARectangleShape.X2    := Round(ConvertValue(x2, GmMeasurement, GmUnits));
  583.   ARectangleShape.Y2    := Round(ConvertValue(y2, GmMeasurement, GmUnits));
  584.   AddObjectToPage(ARectangleShape);
  585. end;
  586.  
  587. procedure TGmCanvas.RotateOut(x, y, Angle: Extended; AText: string; GmMeasurement: TGmMeasurement);
  588. begin
  589.   ShowGmMessage(nil, '"TGmPreview.Canvas.RotateOut"'+#13+#13+PRO_VERSION_ONLY);
  590. end;
  591.  
  592. procedure TGmCanvas.RoundRect(x, y, x2, y2, x3, y3: Extended; GmMeasurement: TGmMeasurement);
  593. var
  594.   ARoundRectShape: TGmRoundRectShape;
  595. begin
  596.   // Create a Round Rect object and add it to the page objects list...
  597.   ARoundRectShape := TGmRoundRectShape.Create;
  598.   ARoundRectShape.Pen   := PenToGmPen(Pen);
  599.   ARoundRectShape.Brush := BrushToGmBrush(Brush);
  600.   ARoundRectShape.X     := Round(ConvertValue(x, GmMeasurement, GmUnits));
  601.   ARoundRectShape.Y     := Round(ConvertValue(y, GmMeasurement, GmUnits));
  602.   ARoundRectShape.X2    := Round(ConvertValue(x2, GmMeasurement, GmUnits));
  603.   ARoundRectShape.Y2    := Round(ConvertValue(y2, GmMeasurement, GmUnits));
  604.   ARoundRectShape.X3    := Round(ConvertValue(x3, GmMeasurement, GmUnits));
  605.   ARoundRectShape.Y3    := Round(ConvertValue(y3, GmMeasurement, GmUnits));
  606.   AddObjectToPage(ARoundRectShape);
  607. end;
  608.  
  609. procedure TGmCanvas.SetDrawingOffset(inchX, inchY: Extended);
  610. begin
  611.   FDrawOffset := GmPoint(inchX, inchY);
  612. end;
  613.  
  614. procedure TGmCanvas.StretchDraw(x,y, x2, y2: Extended; AGraphic: TGraphic; GmMeasurement: TGmMeasurement);
  615. var
  616.   AObject: TGmGraphicObject;
  617.   ARect: TRect;
  618.   ABitmap: TBitmap;
  619. begin
  620.   // create a new graphic object and set its values...
  621.   if Assigned(AGraphic) then
  622.   begin
  623.     ARect.Left    := Round(ConvertValue(x, GmMeasurement, GmUnits));
  624.     ARect.Top     := Round(ConvertValue(y, GmMeasurement, GmUnits));
  625.     ARect.Right   := Round(ConvertValue(x2, GmMeasurement, GmUnits));
  626.     ARect.Bottom  := Round(ConvertValue(y2, GmMeasurement, GmUnits));
  627.     AObject := TGmGraphicObject.Create;
  628.     AObject.CopyMode := FCopyMode;
  629.     AObject.CoordsAsRect := ARect;
  630.     if (AGraphic is TIcon)      then
  631.     begin
  632.       ABitmap := IconToBitmap(TIcon(AGraphic));
  633.       try
  634.         AObject.Graphic := ABitmap;
  635.       finally
  636.         ABitmap.Free;
  637.       end;
  638.     end;
  639.     if (AGraphic is TBitmap)    then AObject.Graphic := (AGraphic as TBitmap);
  640.     if (AGraphic is TMetafile)  then AObject.Graphic := (AGraphic as TMetafile);
  641.     if (AGraphic is TJPEGImage) then AObject.Graphic := (AGraphic as TJPEGImage);
  642.     AddObjectToPage(AObject);
  643.   end;
  644. end;
  645.  
  646. procedure TGmCanvas.StretchDrawTrans(x,y, x2, y2: Extended; AGraphic: TGraphic;
  647.       GmMeasurement: TGmMeasurement; TransparentColor: TColor);
  648. begin
  649. { TODO : stretchdrawtrans }
  650. end;
  651.  
  652. procedure TGmCanvas.TextOut(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);
  653. begin
  654.   TextOutExt(x, y, 0, AText, GmMeasurement);
  655. end;
  656.  
  657. procedure TGmCanvas.TextOutCenter(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);
  658. begin
  659.   TextOut(x, y, AText, GmMeasurement);
  660.   (LastObject as TGmTextObject).Alignment := taCenter;
  661. end;
  662.  
  663. procedure TGmCanvas.TextOutLeft(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);
  664. begin
  665.   TextOut(x, y, AText, GmMeasurement);
  666. end;
  667.  
  668. procedure TGmCanvas.TextOutRight(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);
  669. begin
  670.   TextOut(x, y, AText, GmMeasurement);
  671.   TGmTextObject(LastObject).Alignment := taRightJustify;
  672. end;
  673.  
  674. {$IFDEF D4+}
  675.  
  676. // *** overloaded canvas functions which use the DefaultMeasurement property ***
  677.  
  678. procedure TGmCanvas.Arc(x, y, x2, y2, x3, y3, x4, y4: Extended);
  679. begin
  680.   Arc(x, y, x2, y2, x3, y3, x4, y4, FDefaultMeasurement);
  681. end;
  682.  
  683. procedure TGmCanvas.Chord(x, y, x2, y2, x3, y3, x4, y4: Extended);
  684. begin
  685.   Chord(x, y, x2, y2, x3, y3, x4, y4, FDefaultMeasurement);
  686. end;
  687.  
  688. procedure TGmCanvas.Draw(x, y: Extended; AGraphic: TGraphic; Scale: Extended);
  689. begin
  690.   Draw(x, y, AGraphic, Scale, FDefaultMeasurement);
  691. end;
  692.  
  693. procedure TGmCanvas.DrawTrans(x, y: Extended; AGraphic: TGraphic; Scale: Extended; TransparentColor: TColor);
  694. begin
  695.   DrawTrans(x, y, AGraphic, Scale, FDefaultMeasurement, TransparentColor);
  696. end;
  697.  
  698. procedure TGmCanvas.Ellipse(x, y, x2, y2: Extended);
  699. begin
  700.   Ellipse(x, y, x2, y2, FDefaultMeasurement);
  701. end;
  702.  
  703. procedure TGmCanvas.FillRect(x, y, x2, y2: Extended);
  704. begin
  705.   FillRect(x, y, x2, y2, FDefaultMeasurement);
  706. end;
  707.  
  708. procedure TGmCanvas.FloatOut(x, y, AValue: Extended; Format: string);
  709. begin
  710.   FloatOut(x, y, AValue, Format, FDefaultMeasurement);
  711. end;
  712.  
  713. procedure TGmCanvas.Line(x, y, x2, y2: Extended);
  714. begin
  715.   Line(x, y, x2, y2, FDefaultMeasurement);
  716. end;
  717.  
  718. procedure TGmCanvas.LineTo(x, y: Extended);
  719. begin
  720.   LineTo(x, y, FDefaultMeasurement);
  721. end;
  722.  
  723. procedure TGmCanvas.MoveTo(x, y: Extended);
  724. begin
  725.   MoveTo(x, y, FDefaultMeasurement);
  726. end;
  727.  
  728. procedure TGmCanvas.Pie(x, y, x2, y2, x3, y3, x4, y4: Extended);
  729. begin
  730.   Pie(x, y, x2, y2, x3, y3, x4, y4, FDefaultMeasurement);
  731. end;
  732.  
  733. procedure TGmCanvas.Polygon(Points: array of TGmPoint);
  734. begin
  735.   Polygon(Points, FDefaultMeasurement);
  736. end;
  737.  
  738. procedure TGmCanvas.PolyLine(Points: array of TGmPoint);
  739. begin
  740.   Polyline(Points, FDefaultMeasurement);
  741. end;
  742.  
  743. procedure TGmCanvas.PolyLineTo(Points: array of TGmPoint);
  744. begin
  745.   PolylineTo(Points, FDefaultMeasurement);
  746. end;
  747.  
  748. procedure TGmCanvas.PolyBezier(Points: array of TGmPoint);
  749. begin
  750.   PolyBezier(Points, FDefaultMeasurement);
  751. end;
  752.  
  753. procedure TGmCanvas.PolyBezierTo(Points: array of TGmPoint);
  754. begin
  755.   PolyBezierTo(Points, FDefaultMeasurement);
  756. end;
  757.  
  758. procedure TGmCanvas.Rectangle(x, y, x2, y2: Extended);
  759. begin
  760.   Rectangle(x, y, x2, y2, FDefaultMeasurement);
  761. end;
  762.  
  763. procedure TGmCanvas.RotateOut(x, y, Angle: Extended; AText: string);
  764. begin
  765.   RotateOut(x, y, Angle, AText, FDefaultMeasurement);
  766. end;
  767.  
  768. procedure TGmCanvas.RoundRect(x, y, x2, y2, x3, y3: Extended);
  769. begin
  770.   RoundRect(x, y, x2, y2, x3, y3, FDefaultMeasurement);
  771. end;
  772.  
  773. procedure TGmCanvas.StretchDraw(x,y, x2, y2: Extended; AGraphic: TGraphic);
  774. begin
  775.   StretchDraw(x,y, x2, y2, AGraphic, FDefaultMeasurement);
  776. end;
  777.  
  778. procedure TGmCanvas.TextOut(x, y: Extended; AText: string);
  779. begin
  780.   TextOut(x, y, AText, FDefaultMeasurement);
  781. end;
  782.  
  783. procedure TGmCanvas.TextOutCenter(x, y: Extended; AText: string);
  784. begin
  785.   TextOutCenter(x, y, AText, FDefaultMeasurement);
  786. end;
  787.  
  788. procedure TGmCanvas.TextOutLeft(x, y: Extended; AText: string);
  789. begin
  790.   TextOut(x, y, AText);
  791. end;
  792.  
  793. procedure TGmCanvas.TextOutRight(x, y: Extended; AText: string);
  794. begin
  795.   TextOutRight(x, y, AText, FDefaultMeasurement);
  796. end;
  797.  
  798. {$ENDIF}
  799.  
  800. procedure TGmCanvas.BeginPath;
  801. var
  802.   AObject: TGmPathObject;
  803. begin
  804.   AObject := TGmPathObject.Create;
  805.   AObject.ObjectType := gmBeginPath;
  806.   AddObjectToPage(AObject);
  807. end;
  808.  
  809. procedure TGmCanvas.EndPath;
  810. var
  811.   AObject: TGmPathObject;
  812. begin
  813.   AObject := TGmPathObject.Create;
  814.   AObject.ObjectType := gmEndPath;
  815.   AddObjectToPage(AObject);
  816. end;
  817.  
  818. procedure TGmCanvas.FillPath;
  819. var
  820.   AObject: TGmPathObject;
  821. begin
  822.   AObject := TGmPathObject.Create;
  823.   AObject.ObjectType := gmFillPath;
  824.   AddObjectToPage(AObject);
  825. end;
  826.  
  827. procedure TGmCanvas.StrokePath;
  828. var
  829.   AObject: TGmPathObject;
  830. begin
  831.   AObject := TGmPathObject.Create;
  832.   AObject.ObjectType := gmStrokePath;
  833.   AddObjectToPage(AObject);
  834. end;
  835.  
  836. procedure TGmCanvas.StrokeAndFillPath;
  837. var
  838.   AObject: TGmPathObject;
  839. begin
  840.   AObject := TGmPathObject.Create;
  841.   AObject.ObjectType := gmStrokeAndFillPath;
  842.   AddObjectToPage(AObject);
  843. end;
  844.  
  845. procedure TGmCanvas.CloseFigure;
  846. var
  847.   AObject: TGmPathObject;
  848. begin
  849.   AObject := TGmPathObject.Create;
  850.   AObject.ObjectType := gmCloseFigure;
  851.   AddObjectToPage(AObject);
  852. end;
  853.  
  854. procedure TGmCanvas.SetBrushValues(AColor: TColor; AStyle: TBrushStyle);
  855. begin
  856.   // assign brush properties...
  857.   Brush.Color := AColor;
  858.   Brush.Style := AStyle;
  859. end;
  860.  
  861. procedure TGmCanvas.SetFontValues(AName: string; ASize: integer; AColor: TColor; AStyle: TFontStyles);
  862. begin
  863.   // assign font properties...
  864.   if AName <> '' then
  865.     Font.Name := AName;
  866.   Font.Size := ASize;
  867.   Font.Color := AColor;
  868.   Font.Style := AStyle;
  869. end;
  870.  
  871. procedure TGmCanvas.SetPenValues(AWidth: integer; AColor: TColor; AStyle: TPenStyle);
  872. begin
  873.   // assign pen properties...
  874.   Pen.Color := AColor;
  875.   Pen.Style := AStyle;
  876.   Pen.Width := AWidth;
  877. end;
  878.  
  879. end.
  880.